title: |

author: - Clovis Deletre - Charles Vitry date: output: html_notebook: theme: cerulean number_sections: no toc: yes toc_float: true editor_options: markdown: wrap: 72

Introduction

Nous souhaitons réalisé l’étude d’une série temporelle et faire des prévisions sur celle-ci.

Cette série temporelle est le trafic mensuel d’une Compagnie aérienne de janvier 2011 à août 2019.

Nos prévisions portent sur les 8 mois de l’année 2019

Représentation graphique de la série.

Import des données

Import de la base, on sélectionne la colonne des valeurs

library(readr)
data <- read_delim("Trafic-voyageurs.csv", 
    delim = ";", locale = locale(encoding = "ISO-8859-1"))

Rows: 104 Columns: 2
-- Column specification --------------------------------------------------------------------------------------------------------------------------
Delimiter: ";"
chr (1): dates
dbl (1): trafic

i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.

data_value <- data[,2]
summary(data)

      ds                  y         
 Length:104         Min.   :220876  
 Class :character   1st Qu.:297154  
 Mode  :character   Median :355178  
                    Mean   :354651  
                    3rd Qu.:407331  
                    Max.   :505190  

Création de notre série temporelle

Nous représentons nos données sous forme de série temporelle.

Une série temporelle est un ensemble de métrique mésurée sur des intervalles de temps réguliers.

Création de la série chronologique avec la librairie TSstudio :

• start : année de début,
• frequency : nbr de valeur par an => on en fréquence mensuelle donc 12

library(TSstudio)
data_ts <- ts(data_value, start=2011, frequency=12)
plot_1_TimeSeries(data_ts)

Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

Attachement du package : ‘plotly’

L'objet suivant est masqué depuis ‘package:ggplot2’:

    last_plot

L'objet suivant est masqué depuis ‘package:stats’:

    filter

L'objet suivant est masqué depuis ‘package:graphics’:

    layout

Séparation jeu de données

#revoir l affichage car ca prend pas en compte tt 2019
data_ts_train <- window(data_ts, start = c(2011, 1), end = c(2018,12))
data_ts_test <- window(data_ts, start= c(2019,1), end = c(2019,8))

names(data)[1] <- "ds"
names(data)[2] <- "y"
data_train <- data[1:96,]
data_test <- data[97:104,]


plot(data_ts, xlim=c(2011,2020))
lines(data_ts_test, col=3)

legend("topleft", lty = 1, col=c(1,3), legend=c("Série chronologique Train", "Série chronologique Test"))

-> strong trend -> patern qui se repete, saisonnalité ?

Représentation de la saisonnalité

Analyse de la saisonnalité en superposant chaque année (par mois):

-> en supprimant la tendance on voit bien la saisonnalité => saisonnalité régulière

Analyse de notre série temporelle

Chaque point de notre série temporelle peut être exprimer comme une somme ou un produit de 3 composantes : - Saisonnalité (St), - Tendance (Tt), - Erreur (ϵt),

Yt=St+Tt+ϵt ou Yt=St×Tt×ϵt

La stationnarité d’une série signifique que le processus qui génère la série ne change pas dans le temps. Cela ne veut pas dire que la série ne change pas dans le temps, mais que la façon dont elle change, n’est pas modifié dans le temps.

Testons si la série est stationnaire :

library(tseries)

Warning: le package ‘tseries’ a été compilé avec la version R 4.1.3

    ‘tseries’ version: 0.10-51

    ‘tseries’ is a package for time series analysis and
    computational finance.

    See ‘library(help="tseries")’ for details.

adf.test(data_ts)

Warning in adf.test(data_ts) : p-value smaller than printed p-value

    Augmented Dickey-Fuller Test

data:  data_ts
Dickey-Fuller = -5.4857, Lag order = 4, p-value = 0.01
alternative hypothesis: stationary

kpss.test(data_ts)

Warning in kpss.test(data_ts) : p-value smaller than printed p-value

    KPSS Test for Level Stationarity

data:  data_ts
KPSS Level = 2.0803, Truncation lag parameter = 4,
p-value = 0.01

Donc notre série est bien stationnaire et peut être étudiée facilement.

ggseasonplot(data_ts)

data_ts_without_trend = diff(data_ts)
ggseasonplot(data_ts_without_trend)

Représentation des décompositions possibles

DECOMPOSITION : additive / Multiplicative Ts = Trend + Seasonal + Random / Ts = Trend * Seasonal * Random

decomposed_data <- decompose(data_ts_train, type="additive")
plot(decomposed_data$trend)

plot(decomposed_data$seasonal)

plot(decomposed_data$random)

boxplot(data_ts ~ cycle(data_ts))

-> on distingue des saisonnalités => faire régression ca n’a pas de sens => modèle de Buys Ballot

-> bonne repartition du bruit -> quelques outliers

checkresiduals(remainder(decomposed_data))

Warning in modeldf.default(object) :
  Could not find appropriate degrees of freedom for this model.

On a tendances + saisonnalité

Modèles espace-état

• meanf : Average Method : prend la valeur moyenne de toute les observations pour toutes les prédictions,
• naive : Naive Method : prend la dernière observation pour toutes les prédictions,
• drift : Drift Method : prend la première et la dernière observations et trace une lignes entre les deux, on utilise la courbe pour les prédictions,
• snaive : Seasonal Naive Forecast : Prend la dernière valeur de la saison précédente comme prédiction (ex : sept 2018 = sep 2019 + erreur)

library(forecast)
mean <- meanf(data_ts_train, h=8)
naivem <- naive(data_ts_train, h=8)
driftm <- rwf(data_ts_train, h=8, drif=T)
snaivem <- snaive(data_ts_train, h=8)

plot(mean, plot.conf = F, main="")

Warning in plot.window(xlim, ylim, log, ...) :
  "plot.conf" n'est pas un paramètre graphique
Warning in title(main = main, xlab = xlab, ylab = ylab, ...) :
  "plot.conf" n'est pas un paramètre graphique
Warning in axis(1, ...) : "plot.conf" n'est pas un paramètre graphique
Warning in axis(2, ...) : "plot.conf" n'est pas un paramètre graphique
Warning in box(...) : "plot.conf" n'est pas un paramètre graphique

lines(naivem$mean, col=2, lty=1)

lines(driftm$mean, col=5, lty=1)
lines(snaivem$mean, col = 4, lty=1)

legend("topleft", lty=1, col=c(1,2,3,4), legend=c("Mean Method", "Naive Method", "Drif Method", "Seasonal Naive"))

#comparaison :
plot(snaivem, plot.conf = F, main="")

Warning in plot.window(xlim, ylim, log, ...) :
  "plot.conf" n'est pas un paramètre graphique
Warning in title(main = main, xlab = xlab, ylab = ylab, ...) :
  "plot.conf" n'est pas un paramètre graphique
Warning in axis(1, ...) : "plot.conf" n'est pas un paramètre graphique
Warning in axis(2, ...) : "plot.conf" n'est pas un paramètre graphique
Warning in box(...) : "plot.conf" n'est pas un paramètre graphique

lines(data_ts_test, col = 6, lty=1, lwd=3)

plot(driftm, plot.conf = F, main="")

Warning in plot.window(xlim, ylim, log, ...) :
  "plot.conf" n'est pas un paramètre graphique
Warning in title(main = main, xlab = xlab, ylab = ylab, ...) :
  "plot.conf" n'est pas un paramètre graphique
Warning in axis(1, ...) : "plot.conf" n'est pas un paramètre graphique
Warning in axis(2, ...) : "plot.conf" n'est pas un paramètre graphique
Warning in box(...) : "plot.conf" n'est pas un paramètre graphique

lines(data_ts_test, col = 6, lty=1, lwd=3)

On regarde : MAE : Mean Absolute Error : RMSE : Root Mean Squarred Error

MASE : Mean Absolute Scaled Error : MAPE : Mean Absolute Percentage Error :

res = pred - val MAE = sum(abs(res))/length(val) RSS = sum(res^2) MSE = RSS/length(val) RMSE = sqrt(MSE)

La plus populaire est la MAPE

MAPE(y_pred, y_true)

$MAPE = (1/n) * Σ(|actual – forecast| / |actu0al|) * 10

“a MAPE value of 6% means that the average difference between the forecasted value and the actual value is 6%”

print(summary(mean))

Forecast method: Mean

Model Information:
$mu
[1] 346667.1

$mu.se
[1] 6731.642

$sd
[1] 65956.35

$bootstrap
[1] FALSE

$call
meanf(y = data_ts_train, h = 8)

attr(,"class")
[1] "meanf"

Error measures:
                       ME     RMSE      MAE       MPE     MAPE    MASE      ACF1
Training set 1.941958e-11 65611.93 55535.08 -3.855657 17.01186 2.16177 0.8254447

Forecasts:

checkresiduals(mean)

    Ljung-Box test

data:  Residuals from Mean
Q* = 731.64, df = 18, p-value < 2.2e-16

Model df: 1.   Total lags used: 19

accuracy(mean, data_ts_test)

                       ME      RMSE       MAE       MPE     MAPE     MASE      ACF1 Theil's U
Training set 1.941958e-11  65611.93  55535.08 -3.855657 17.01186 2.161770 0.8254447        NA
Test set     1.037870e+05 110031.92 103787.04 22.486144 22.48614 4.040036 0.0485288  2.517689

print(summary(naivem))

Forecast method: Naive method

Model Information:
Call: naive(y = data_ts_train, h = 8) 

Residual sd: 36679.9508 

Error measures:
                   ME     RMSE      MAE         MPE     MAPE     MASE       ACF1
Training set 1896.811 36679.95 29013.27 -0.02007386 8.597313 1.129377 -0.2744236

Forecasts:

checkresiduals(naivem)

    Ljung-Box test

data:  Residuals from Naive method
Q* = 248.52, df = 19, p-value < 2.2e-16

Model df: 0.   Total lags used: 19

accuracy(naivem, data_ts_test)

                    ME     RMSE      MAE         MPE     MAPE     MASE       ACF1 Theil's U
Training set  1896.811 36679.95 29013.27 -0.02007386 8.597313 1.129377 -0.2744236        NA
Test set     24357.125 43915.19 38328.62  4.72582164 8.499751 1.491988  0.0485288  1.063155

print(summary(driftm))

Forecast method: Random walk with drift

Model Information:
Call: rwf(y = data_ts_train, h = 8, drift = T) 

Drift: 1896.8105  (se 3778.1861)
Residual sd: 36825.2032 

Error measures:
                       ME     RMSE      MAE        MPE     MAPE    MASE       ACF1
Training set 2.297696e-11 36630.87 28899.04 -0.5861884 8.591266 1.12493 -0.2744236

Forecasts:

checkresiduals(driftm)

    Ljung-Box test

data:  Residuals from Random walk with drift
Q* = 248.52, df = 18, p-value < 2.2e-16

Model df: 1.   Total lags used: 19

accuracy(driftm, data_ts_test)

                       ME     RMSE      MAE        MPE     MAPE     MASE        ACF1 Theil's U
Training set 2.297696e-11 36630.87 28899.04 -0.5861884 8.591266 1.124930 -0.27442358        NA
Test set     1.582148e+04 41314.60 33586.60  2.7843152 7.582963 1.307399  0.06907259  1.007801

print(summary(snaivem))

Forecast method: Seasonal naive method

Model Information:
Call: snaive(y = data_ts_train, h = 8) 

Residual sd: 28666.7301 

Error measures:
                   ME     RMSE      MAE      MPE     MAPE MASE      ACF1
Training set 25337.46 28666.73 25689.63 7.101745 7.207375    1 0.2695124

Forecasts:

checkresiduals(snaivem)

    Ljung-Box test

data:  Residuals from Seasonal naive method
Q* = 35.426, df = 19, p-value = 0.0124

Model df: 0.   Total lags used: 19

accuracy(snaivem, data_ts_test)

                   ME     RMSE      MAE      MPE     MAPE      MASE       ACF1 Theil's U
Training set 25337.46 28666.73 25689.63 7.101745 7.207375 1.0000000  0.2695124        NA
Test set     14263.38 22148.43 16960.88 3.053421 3.648407 0.6602226 -0.5427745 0.4792835

Etude du Modèle de Buys-Ballot

Modèle

https://mpra.ub.uni-muenchen.de/77718/1/MPRA_paper_77718.pdf page 175

L’approche de BUYS-BALLOT consiste à introduire des variables indicatrices correspondant à chaque saison définit par le cycle d’observation. Pour les données trimestrielles, on intègre 4 variables indicatrices. Et pour les données mensuelles, on intègre 12 variables indicatrices.

Le modèle doit alors être estimé (sans constante) avec ces variables indicatrices.

Prédiction des valeurs de 2019

Préparation des données.

Annees=as.numeric(time(data_ts_train))
ts_DataFrame =data.frame(trafic=data_ts_train,X=as.numeric(Annees))

Création du modèle

Regression <- lm(trafic~X,data = ts_DataFrame)

\(Xt = Zt + St + \mu t\)

La tendance Prédiction sur les données futurs.

tendance=predict(Regression)

AnneeMoisNumericFutur=seq(max(Annees)+1/12,length=8,by=1/12)  #les 10 prochains mois

tendance2=predict(Regression, newdata=data.frame(X=AnneeMoisNumericFutur)) 

ts_DataFrame$trafic_residual <- residuals(Regression)

Définissons le mois

ts_DataFrame$mois <- round(ts_DataFrame$X - trunc(ts_DataFrame$X),digit=4)

Création du 2nd modèle avec les mois

Regression2 =lm(trafic_residual~0+as.factor(mois),data=ts_DataFrame)

Prédiction de la saisonnalité

prediction2 =predict(Regression2)

Prédiction sur les mois

MoisNumeric= round(AnneeMoisNumericFutur - trunc(AnneeMoisNumericFutur
                     ),4)
Prediction3 =predict( Regression2, newdata= data.frame(mois=MoisNumeric))

Calculons une région de confiance avec l’erreur d’ajustement

ResidusRegression2=residuals(Regression2)
hist(ResidusRegression2)

1.96*sqrt(var(ResidusRegression2))

[1] 19226.16

Auto corrélation de la série temporelle

L’autocorrélation de notre série temporelle correspond à la corrélation entre une mesure du trafic \(t\) et les mesures précédentes \(t - k\) ou les mesures suivantes \(t + k\).

L’auto covariance d’une variable \(Xt\) de moyenne \(\mu\) et d’écart type \(\sigma\) à un décalage \(k\) est donné par la formule

\(\gamma_k= E((X_t-\mu)(X_{t+k}-\mu))\)

On en déduit l’autocorrélation correspondante :

\(\rho_k=\frac{\gamma_k}{\sigma^2}\)

Affichons les autocorrélations de la séries grâce à un corrélogramme

ACF_Sur_Valeurs_Predites <- acf(prediction2)

Il est normal que la série soit autocorrélé totalement à elle avec un décalage nulle.

On observe une corrélation forte (0.87) avec un décalage (lag) de 12, cela correspond bien à une saisonnalité annuelle.

print(data.frame(ACF_Sur_Valeurs_Predites$lag,ACF_Sur_Valeurs_Predites$acf)[1:13,])

Recalculons la valeur d’auto-corrélation obtenu en appliquant la formule.

Observons l’application de la formule, en choisissant un décalage de 12

#Constantes
Nombre_Observations=96
decalage=12

#Estimations
moyenneMu=mean(prediction2)
sdSigma=sd(prediction2)


Serie1=prediction2[(decalage+1): 96   ]
Serie2=prediction2[   1 :(96-decalage)]

GammaDecalage12=mean((Serie1-moyenneMu)*(Serie2-moyenneMu))*((Nombre_Observations-decalage)/(Nombre_Observations))

RhoDecalage12=GammaDecalage12/(sdSigma^2)
RhoDecalage12

[1] 0.8658622

Le résultat obtenu est correct. L’auto corrélation avec un décalage de 12 est donc très forte.

De plus cette auto corrélation étant positive, cela indique une tendance croissante.

la deuxième plus forte corrélation est obsersé avec un décalage de 5, observons cela graphiquement

plot  ( 1:length(prediction2),   prediction2,type="l")
points((1:length(prediction2))-5,prediction2,type="l",col="red")

Cette corrélation est peu pertinente.

print(data.frame(ACF_Sur_Valeurs_Predites$lag,ACF_Sur_Valeurs_Predites$acf)[1:13,])

Après avoir étudier les auto-corrélations sur l’ensemble du modèle, Observons les auto-corrélations sur les résidus du modèle de Buys-Ballot.

• Texte pour dire que les accidents ne doivent pas être corrélés *

plot(acf(ResidusRegression2))

Pour notre modèle, il n’y a aucune auto-corrélation significative. (symbolisé par la ligne bleu)

Comparaison des prédictions et des valeurs réelles

Affichage de la tendance

Buys_ballot_plot_tendance <- plot(data_ts,
                         main = "Application du modèle de Buys_Ballot",
                         xlab = "Années",
                         ylab = "Nombre de Voyageurs") 

#droite de tendance
lines(Annees,tendance,col="blue",lwd=2)  

#prédiction de la tendance futur
lines(AnneeMoisNumericFutur,tendance2,col="red")

NA
NA

Affichage du modèle de Buys Ballot

Buys_ballot_plot <- plot(data_ts,
                         main = "Application du modèle de Buys_Ballot",
                         xlab = "Années",
                         ylab = "Nombre de Voyageurs") 



#prédiction du modèle de Buys ballot
lines(Annees,tendance+prediction2,col="blue",lwd=2)

#Interval de confiance
 polygon(c(AnneeMoisNumericFutur,rev(AnneeMoisNumericFutur)),
 c(tendance2+Prediction3-1.96*sqrt(var(ResidusRegression2)),
 rev(tendance2+Prediction3+1.96*sqrt(var(ResidusRegression2)))),
 col="cadetblue1",border=NA)
 
 #Prediction des valeurs
 lines(AnneeMoisNumericFutur,tendance2+Prediction3,col="blue",lwd=2)

 
 
 lines(data_ts_test,col="black",lwd=3)

Affichage de la prédiction sur les 8 mois de 2020

Buys_ballot_plot <- plot(data_ts_test,
                         main = "Application du modèle de Buys_Ballot",
                         xlab = "Années",
                         ylab = "Nombre de Voyageurs") 



#prédiction du modèle de Buys ballot
lines(Annees,tendance+prediction2,col="blue",lwd=2)

#Interval de confiance
 polygon(c(AnneeMoisNumericFutur,rev(AnneeMoisNumericFutur)),
 c(tendance2+Prediction3-1.96*sqrt(var(ResidusRegression2)),
 rev(tendance2+Prediction3+1.96*sqrt(var(ResidusRegression2)))),
 col="cadetblue1",border=NA)
 
 #Prediction des valeurs
 lines(AnneeMoisNumericFutur,tendance2+Prediction3,col="blue",lwd=2)

 
 
 lines(data_ts_test,col="black",lwd=3)

Préparation DataFrame pour affichage ggplot

DataAffichageGGplot = as.data.frame(data_ts)
DataAffichageGGplot$Annees = c(Annees, AnneeMoisNumericFutur)
DataAffichageGGplot$AnneesRound = round(DataAffichageGGplot$Annees)
DataAffichageGGplot$PredictionTendance = c(tendance ,tendance2)
DataAffichageGGplot$BuysBalotModele = c(tendance+prediction2,tendance2+Prediction3 )

Reproduisons les graphiques avec ggplot2 pour un résultat plus professsionnel.

library(ggplot2)
library(ggthemes)

p <- ggplot(data =DataAffichageGGplot, aes(x = Annees) ) + 

  geom_line(aes(y = trafic ), size = 0.9, alpha = 0.7)+

  #geom_line(aes(y = PredictionTendance), size = 0.6, alpha = 0.85,linetype="twodash" )+
  
  geom_line(aes(y = BuysBalotModele), size = 1.2, alpha = 0.6, color = "blue")+
  labs(title = "Application du modèle de Buys_Ballot",
       x="Années",
         y= "Nombre de Voyageurs")+
theme_fivethirtyeight()+
  theme(axis.title = element_text(), text = element_text(family = "Rubik")) 

#sur l'année 2019
p2 <- ggplot(data =DataAffichageGGplot, aes(x = Annees) ) + 
  geom_line(aes(y = trafic ), size = 1.2, alpha = 0.7)+
  geom_line(aes(y = BuysBalotModele), size = 1.4, alpha = 0.6, color = "blue")+
theme_fivethirtyeight()+
   xlim (2019.0, 2019.583) +
  ylim (435000, 520000) 


#Ajout zoom sur 2019
p + 
  annotation_custom(ggplotGrob(p2), xmin = 2015, xmax = 2020, ymin = 50000, ymax = 280000) +
  geom_rect(aes(xmin = 2015, xmax = 2020, ymin = 50000, ymax = 280000), color='black', linetype='dashed', alpha=0) 

NA
NA
NA

Nous avons réussi à ajuster une droite de régression. on remarque que la prédiction semble bien correspondre à la réalité si on fait abstraction du dernier mois où le nombre de voyageurs a bien plus chuté que la prédiction du modèle de Buys-Balot.

Comparons avec un ajustement local réalisé par lissage moyennes mobiles.

Comparaison avec les valeurs observées

Lissage moyenne mobile

Définition

Mettre belle formule en latex ici

Choix Moyenne mobiles

Conservation & Annulation

Lissage exponentielle

Lissage simple

fcst_se <- ses(data_ts_train, h = 8)
print(summary(fcst_se))

Forecast method: Simple exponential smoothing

Model Information:
Simple exponential smoothing 

Call:
 ses(y = data_ts_train, h = 8) 

  Smoothing parameters:
    alpha = 0.2559 

  Initial states:
    l = 258126.0245 

  sigma:  31480.96

     AIC     AICc      BIC 
2430.727 2430.988 2438.420 

Error measures:
                   ME     RMSE      MAE      MPE     MAPE     MASE      ACF1
Training set 7057.127 31151.31 25752.89 1.326234 7.684321 1.002462 0.0711143

Forecasts:

checkresiduals(fcst_se)

    Ljung-Box test

data:  Residuals from Simple exponential smoothing
Q* = 144.66, df = 17, p-value < 2.2e-16

Model df: 2.   Total lags used: 19

plot(fcst_se)
lines(data_ts_test, col="red")

df_se = as.data.frame(fcst_se)
predict_value_se <- df_se$`Point Forecast`
MAPE(predict_value_se, data_ts_test)*100

[1] 7.658334

Optimisation du modèle

Fit Exponential Smoothing model -> trouve le meilleur lissage expo

fit_ets <- ets(data_ts_train) 
print(summary(fit_ets))

ETS(A,A,A) 

Call:
 ets(y = data_ts_train) 

  Smoothing parameters:
    alpha = 0.1568 
    beta  = 1e-04 
    gamma = 1e-04 

  Initial states:
    l = 248267.1099 
    b = 2163.3982 
    s = -17928.3 -29535.73 9295.935 11005.81 -57117.85 -7708.17
           38272.64 14592.34 16899.53 34763.15 -7344.204 -5195.15

  sigma:  11014.45

     AIC     AICc      BIC 
2241.611 2249.458 2285.205 

Training set error measures:
                    ME     RMSE      MAE        MPE     MAPE      MASE       ACF1
Training set -458.6799 10054.77 7831.554 -0.2623253 2.371375 0.3048527 0.09626331

checkresiduals(fit_ets)

    Ljung-Box test

data:  Residuals from ETS(A,A,A)
Q* = 7.1794, df = 3, p-value = 0.06639

Model df: 16.   Total lags used: 19

fcst_ets <- forecast(fit_ets, h=8)
plot(fcst_ets)
lines(data_ts_test, col="red")

df_ets = as.data.frame(fcst_ets)
predict_value_ets = df_ets$`Point Forecast`
MAPE(predict_value_ets, data_ts_test)*100

[1] 3.005848

Modèle ARMA

A FAIRE

Modèle ARIMA / SAMIRA Automatique

ARIMA : AutoRegressive Integrated Moving Average

Le modèle ARIMA est une combinaison du modèle ARMA combiné à une différentiation (le Integrated)

Différentiation = rétirer les tendances -> tendance linéaire : une différenciation -> tendance quadradique : deux différenciations

Le modèle SARIMA est une combinaison du modèle ARIMA qui prend en compte la composante saisonniaire.

auto.arima prend en compte les saisonnalités, comme on peut le voir dans le modèle selectionné : (0,1,1)(0,1,1)[12]

# retourne les meilleurs paramètres 
# d=1 enleve la tendance
# D=1 enleve la saisonnalité 
# => avoir des données stationnaires
# trace : voir les résultats
fit_arima <- auto.arima(data_ts_train, d=1, D=1, stepwise = FALSE, approximation = FALSE, trace=TRUE)

 ARIMA(0,1,0)(0,1,0)[12]                    : 1846.398
 ARIMA(0,1,0)(0,1,1)[12]                    : 1833.134
 ARIMA(0,1,0)(0,1,2)[12]                    : 1835.211
 ARIMA(0,1,0)(1,1,0)[12]                    : 1833.056
 ARIMA(0,1,0)(1,1,1)[12]                    : 1835.09
 ARIMA(0,1,0)(1,1,2)[12]                    : Inf
 ARIMA(0,1,0)(2,1,0)[12]                    : 1835.207
 ARIMA(0,1,0)(2,1,1)[12]                    : 1837.012
 ARIMA(0,1,0)(2,1,2)[12]                    : 1836.461
 ARIMA(0,1,1)(0,1,0)[12]                    : 1814.951
 ARIMA(0,1,1)(0,1,1)[12]                    : 1801.155
 ARIMA(0,1,1)(0,1,2)[12]                    : 1803.362
 ARIMA(0,1,1)(1,1,0)[12]                    : 1803.592
 ARIMA(0,1,1)(1,1,1)[12]                    : 1803.361
 ARIMA(0,1,1)(1,1,2)[12]                    : Inf
 ARIMA(0,1,1)(2,1,0)[12]                    : 1805.004
 ARIMA(0,1,1)(2,1,1)[12]                    : 1805.397
 ARIMA(0,1,1)(2,1,2)[12]                    : Inf
 ARIMA(0,1,2)(0,1,0)[12]                    : 1816.915
 ARIMA(0,1,2)(0,1,1)[12]                    : 1803.033
 ARIMA(0,1,2)(0,1,2)[12]                    : 1805.296
 ARIMA(0,1,2)(1,1,0)[12]                    : 1805.702
 ARIMA(0,1,2)(1,1,1)[12]                    : 1805.295
 ARIMA(0,1,2)(1,1,2)[12]                    : Inf
 ARIMA(0,1,2)(2,1,0)[12]                    : 1807.026
 ARIMA(0,1,2)(2,1,1)[12]                    : 1807.441
 ARIMA(0,1,3)(0,1,0)[12]                    : 1817.787
 ARIMA(0,1,3)(0,1,1)[12]                    : Inf
 ARIMA(0,1,3)(0,1,2)[12]                    : Inf
 ARIMA(0,1,3)(1,1,0)[12]                    : Inf
 ARIMA(0,1,3)(1,1,1)[12]                    : Inf
 ARIMA(0,1,3)(2,1,0)[12]                    : Inf
 ARIMA(0,1,4)(0,1,0)[12]                    : 1820.052
 ARIMA(0,1,4)(0,1,1)[12]                    : Inf
 ARIMA(0,1,4)(1,1,0)[12]                    : Inf
 ARIMA(0,1,5)(0,1,0)[12]                    : Inf
 ARIMA(1,1,0)(0,1,0)[12]                    : 1825.579
 ARIMA(1,1,0)(0,1,1)[12]                    : 1812.512
 ARIMA(1,1,0)(0,1,2)[12]                    : 1814.657
 ARIMA(1,1,0)(1,1,0)[12]                    : 1813.2
 ARIMA(1,1,0)(1,1,1)[12]                    : 1814.614
 ARIMA(1,1,0)(1,1,2)[12]                    : 1816.192
 ARIMA(1,1,0)(2,1,0)[12]                    : 1815.227
 ARIMA(1,1,0)(2,1,1)[12]                    : Inf
 ARIMA(1,1,0)(2,1,2)[12]                    : 1817.796
 ARIMA(1,1,1)(0,1,0)[12]                    : 1816.841
 ARIMA(1,1,1)(0,1,1)[12]                    : 1802.853
 ARIMA(1,1,1)(0,1,2)[12]                    : 1805.117
 ARIMA(1,1,1)(1,1,0)[12]                    : 1805.653
 ARIMA(1,1,1)(1,1,1)[12]                    : Inf
 ARIMA(1,1,1)(1,1,2)[12]                    : Inf
 ARIMA(1,1,1)(2,1,0)[12]                    : Inf
 ARIMA(1,1,1)(2,1,1)[12]                    : Inf
 ARIMA(1,1,2)(0,1,0)[12]                    : 1819.234
 ARIMA(1,1,2)(0,1,1)[12]                    : 1805.22
 ARIMA(1,1,2)(0,1,2)[12]                    : 1807.539
 ARIMA(1,1,2)(1,1,0)[12]                    : 1807.381
 ARIMA(1,1,2)(1,1,1)[12]                    : 1807.538
 ARIMA(1,1,2)(2,1,0)[12]                    : 1808.925
 ARIMA(1,1,3)(0,1,0)[12]                    : 1820.05
 ARIMA(1,1,3)(0,1,1)[12]                    : 1806.055
 ARIMA(1,1,3)(1,1,0)[12]                    : 1808.732
 ARIMA(1,1,4)(0,1,0)[12]                    : Inf
 ARIMA(2,1,0)(0,1,0)[12]                    : 1824.435
 ARIMA(2,1,0)(0,1,1)[12]                    : 1811.07
 ARIMA(2,1,0)(0,1,2)[12]                    : 1813.287
 ARIMA(2,1,0)(1,1,0)[12]                    : 1811.619
 ARIMA(2,1,0)(1,1,1)[12]                    : 1813.247
 ARIMA(2,1,0)(1,1,2)[12]                    : Inf
 ARIMA(2,1,0)(2,1,0)[12]                    : 1813.821
 ARIMA(2,1,0)(2,1,1)[12]                    : 1815.872
 ARIMA(2,1,1)(0,1,0)[12]                    : Inf
 ARIMA(2,1,1)(0,1,1)[12]                    : Inf
 ARIMA(2,1,1)(0,1,2)[12]                    : Inf
 ARIMA(2,1,1)(1,1,0)[12]                    : Inf
 ARIMA(2,1,1)(1,1,1)[12]                    : Inf
 ARIMA(2,1,1)(2,1,0)[12]                    : Inf
 ARIMA(2,1,2)(0,1,0)[12]                    : Inf
 ARIMA(2,1,2)(0,1,1)[12]                    : Inf
 ARIMA(2,1,2)(1,1,0)[12]                    : Inf
 ARIMA(2,1,3)(0,1,0)[12]                    : Inf
 ARIMA(3,1,0)(0,1,0)[12]                    : 1823.646
 ARIMA(3,1,0)(0,1,1)[12]                    : 1808.49
 ARIMA(3,1,0)(0,1,2)[12]                    : 1810.542
 ARIMA(3,1,0)(1,1,0)[12]                    : 1808.594
 ARIMA(3,1,0)(1,1,1)[12]                    : 1810.321
 ARIMA(3,1,0)(2,1,0)[12]                    : 1810.708
 ARIMA(3,1,1)(0,1,0)[12]                    : Inf
 ARIMA(3,1,1)(0,1,1)[12]                    : Inf
 ARIMA(3,1,1)(1,1,0)[12]                    : Inf
 ARIMA(3,1,2)(0,1,0)[12]                    : Inf
 ARIMA(4,1,0)(0,1,0)[12]                    : 1823.996
 ARIMA(4,1,0)(0,1,1)[12]                    : 1810.199
 ARIMA(4,1,0)(1,1,0)[12]                    : 1810.845
 ARIMA(4,1,1)(0,1,0)[12]                    : Inf
 ARIMA(5,1,0)(0,1,0)[12]                    : 1825.055



 Best model: ARIMA(0,1,1)(0,1,1)[12]                    

print(summary(fit_arima))

Series: data_ts_train 
ARIMA(0,1,1)(0,1,1)[12] 

Coefficients:
          ma1     sma1
      -0.7675  -0.5465
s.e.   0.0977   0.1295

sigma^2 = 138827719:  log likelihood = -897.43
AIC=1800.85   AICc=1801.16   BIC=1808.11

Training set error measures:
                   ME     RMSE      MAE       MPE     MAPE      MASE       ACF1
Training set 805.2378 10822.93 7747.841 0.2158443 2.213481 0.3015941 0.03453594

checkresiduals(fit_arima)

    Ljung-Box test

data:  Residuals from ARIMA(0,1,1)(0,1,1)[12]
Q* = 10.898, df = 17, p-value = 0.8618

Model df: 2.   Total lags used: 19

fcst_arima <- forecast(fit_arima, h=8)
plot(fcst_arima)
lines(data_ts_test, col='red')

df_arima = as.data.frame(fcst_arima)
predict_value_arima = df_arima$`Point Forecast`
MAPE(predict_value_arima, data_ts_test)*100

[1] 2.814135

PROPHET

Préparation données

library(zoo)

Attachement du package : ‘zoo’

Les objets suivants sont masqués depuis ‘package:base’:

    as.Date, as.Date.numeric

data_train$ds <- as.Date( as.yearmon(time(data_ts_train)))

A COMMENTER ET A FAIRE FONCTIONNER SURTT (changement de la forme des dates?)

library(prophet)
model_prophet <- prophet(data_train)

Disabling weekly seasonality. Run prophet with weekly.seasonality=TRUE to override this.
Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.

forecast_prophet <- make_future_dataframe(model_prophet, periods = 8, freq = 'month')
AAPLfc <- predict(model_prophet, forecast_prophet)
tail(AAPLfc[c("ds", "yhat", "yhat_lower", "yhat")])

dyplot.prophet(model_prophet, AAPLfc)

data_pp <- subset(AAPLfc, select=c("yhat"))
data_pp_ts <- ts(data_tttt, start=2011, frequency=12)
data_pp_ts_w <- window(data_pp_ts, start= c(2019,1), end = c(2019,8))



plot(data_ts)
lines(data_pp_ts_w, col="red")

MAPE(data_pp_ts_w, data_ts_test)*100

[1] 3.396584

LSTM

scale_factors <- c(mean(data$y), sd(data$y))
scaled_train <- data %>%
    dplyr::select(y) %>%
    dplyr::mutate(y = (y - scale_factors[1]) / scale_factors[2])
scaled_train

prediction <- 12
lag <- prediction

On veut prendre l’année précedente pour apprendre > lag de 12, en réalité ca fait 12 - 1 pour avoir à chaque prédiction basée sur 12 valeurs

puis en transforme en array 3D car le modèle LSTM prendre un tensor de format 3D [samples, timesteps, features] samples : nbr d’observation par batchs timesteps : lag features : nbr de valeur predites

scaled_train <- as.matrix(scaled_train)
 
# we lag the data 11 times and arrange that into columns
x_train_data <- t(sapply(
    1:(length(scaled_train) - lag - prediction + 1),
    function(x) scaled_train[x:(x + lag - 1), 1]
  ))
 
# now we transform it into 3D form
x_train_arr <- array(
    data = as.numeric(unlist(x_train_data)),
    dim = c(
        nrow(x_train_data),
        lag,
        1
    )
)

#(x_train_data)
#length(x_train_arr)
#head(x_train_arr)

y_train_data <- t(sapply(
    (1 + lag):(length(scaled_train) - prediction + 1),
    function(x) scaled_train[x:(x + prediction - 1)]
))

y_train_arr <- array(
    data = as.numeric(unlist(y_train_data)),
    dim = c(
        nrow(y_train_data),
        prediction,
        1
    )
)

#head(y_train_data)
#head(y_train_arr)

x_test <- data$y[(nrow(scaled_train) - prediction + 1):nrow(scaled_train)]

x_test_scaled <- (x_test - scale_factors[1]) / scale_factors[2]

x_pred_arr <- array(
    data = x_test_scaled,
    dim = c(
        1,
        lag,
        1
    )
)

lstm_model <- keras_model_sequential()

lstm_model %>%
  layer_lstm(units = 50, # size of the layer
       batch_input_shape = c(1, 12, 1), # batch size, timesteps, features
       return_sequences = TRUE,
       stateful = TRUE) %>%
  # fraction of the units to drop for the linear transformation of the inputs
  layer_dropout(rate = 0.5) %>%
  layer_lstm(units = 50,
        return_sequences = TRUE,
        stateful = TRUE) %>%
  layer_dropout(rate = 0.5) %>%
  time_distributed(keras::layer_dense(units = 1))

lstm_model %>%
    compile(loss = 'mae', optimizer = 'adam', metrics = 'accuracy')

summary(lstm_model)

Model: "sequential_3"
_________________________________________________________________
 Layer (type)                Output Shape              Param #   
=================================================================
 lstm_7 (LSTM)               (1, 12, 50)               10400     
 dropout_7 (Dropout)         (1, 12, 50)               0         
 lstm_6 (LSTM)               (1, 12, 50)               20200     
 dropout_6 (Dropout)         (1, 12, 50)               0         
 time_distributed_3 (TimeDis  (1, 12, 1)               51        
 tributed)                                                       
=================================================================
Total params: 30,651
Trainable params: 30,651
Non-trainable params: 0
_________________________________________________________________

lstm_model %>% fit(
    x = x_train_arr,
    y = y_train_arr,
    batch_size = 1,
    epochs = 20,
    verbose = 1,
    shuffle = FALSE
)

Epoch 1/20

 1/81 [..............................] - ETA: 3:53 - loss: 1.2196 - accuracy: 0.0000e+00
10/81 [==>...........................] - ETA: 0s - loss: 0.6508 - accuracy: 0.0000e+00  
19/81 [======>.......................] - ETA: 0s - loss: 0.5166 - accuracy: 0.0000e+00
28/81 [=========>....................] - ETA: 0s - loss: 0.4629 - accuracy: 0.0000e+00
38/81 [=============>................] - ETA: 0s - loss: 0.4150 - accuracy: 0.0000e+00
48/81 [================>.............] - ETA: 0s - loss: 0.4078 - accuracy: 0.0000e+00
58/81 [====================>.........] - ETA: 0s - loss: 0.4323 - accuracy: 0.0000e+00
68/81 [========================>.....] - ETA: 0s - loss: 0.4429 - accuracy: 0.0000e+00
77/81 [===========================>..] - ETA: 0s - loss: 0.4624 - accuracy: 0.0000e+00
81/81 [==============================] - 3s 6ms/step - loss: 0.4697 - accuracy: 0.0000e+00

81/81 [==============================] - 4s 12ms/step - loss: 0.4697 - accuracy: 0.0000e+00
Epoch 2/20

 1/81 [..............................] - ETA: 0s - loss: 1.7441 - accuracy: 0.0000e+00
 9/81 [==>...........................] - ETA: 0s - loss: 1.0279 - accuracy: 0.0000e+00
18/81 [=====>........................] - ETA: 0s - loss: 0.7254 - accuracy: 0.0000e+00
26/81 [========>.....................] - ETA: 0s - loss: 0.6267 - accuracy: 0.0000e+00
33/81 [===========>..................] - ETA: 0s - loss: 0.5566 - accuracy: 0.0000e+00
41/81 [==============>...............] - ETA: 0s - loss: 0.5079 - accuracy: 0.0000e+00
50/81 [=================>............] - ETA: 0s - loss: 0.4753 - accuracy: 0.0000e+00
59/81 [====================>.........] - ETA: 0s - loss: 0.4660 - accuracy: 0.0000e+00
67/81 [=======================>......] - ETA: 0s - loss: 0.4515 - accuracy: 0.0000e+00
71/81 [=========================>....] - ETA: 0s - loss: 0.4478 - accuracy: 0.0000e+00
80/81 [============================>.] - ETA: 0s - loss: 0.4429 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 7ms/step - loss: 0.4419 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.4419 - accuracy: 0.0000e+00
Epoch 3/20

 1/81 [..............................] - ETA: 0s - loss: 1.7155 - accuracy: 0.0000e+00
 8/81 [=>............................] - ETA: 0s - loss: 0.6954 - accuracy: 0.0000e+00
15/81 [====>.........................] - ETA: 0s - loss: 0.5548 - accuracy: 0.0000e+00
24/81 [=======>......................] - ETA: 0s - loss: 0.5052 - accuracy: 0.0000e+00
33/81 [===========>..................] - ETA: 0s - loss: 0.4540 - accuracy: 0.0000e+00
41/81 [==============>...............] - ETA: 0s - loss: 0.4305 - accuracy: 0.0000e+00
50/81 [=================>............] - ETA: 0s - loss: 0.4080 - accuracy: 0.0000e+00
59/81 [====================>.........] - ETA: 0s - loss: 0.4005 - accuracy: 0.0000e+00
67/81 [=======================>......] - ETA: 0s - loss: 0.4002 - accuracy: 0.0000e+00
76/81 [===========================>..] - ETA: 0s - loss: 0.3985 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.3975 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.3975 - accuracy: 0.0000e+00
Epoch 4/20

 1/81 [..............................] - ETA: 0s - loss: 1.3672 - accuracy: 0.0000e+00
10/81 [==>...........................] - ETA: 0s - loss: 0.5138 - accuracy: 0.0000e+00
18/81 [=====>........................] - ETA: 0s - loss: 0.4371 - accuracy: 0.0000e+00
27/81 [=========>....................] - ETA: 0s - loss: 0.4106 - accuracy: 0.0000e+00
36/81 [============>.................] - ETA: 0s - loss: 0.3880 - accuracy: 0.0000e+00
46/81 [================>.............] - ETA: 0s - loss: 0.3691 - accuracy: 0.0000e+00
55/81 [===================>..........] - ETA: 0s - loss: 0.3653 - accuracy: 0.0000e+00
63/81 [======================>.......] - ETA: 0s - loss: 0.3649 - accuracy: 0.0000e+00
71/81 [=========================>....] - ETA: 0s - loss: 0.3666 - accuracy: 0.0000e+00
79/81 [============================>.] - ETA: 0s - loss: 0.3698 - accuracy: 0.0000e+00
81/81 [==============================] - 0s 6ms/step - loss: 0.3701 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.3701 - accuracy: 0.0000e+00
Epoch 5/20

 1/81 [..............................] - ETA: 0s - loss: 1.2701 - accuracy: 0.0000e+00
10/81 [==>...........................] - ETA: 0s - loss: 0.5676 - accuracy: 0.0000e+00
19/81 [======>.......................] - ETA: 0s - loss: 0.4692 - accuracy: 0.0000e+00
27/81 [=========>....................] - ETA: 0s - loss: 0.4338 - accuracy: 0.0000e+00
35/81 [===========>..................] - ETA: 0s - loss: 0.4071 - accuracy: 0.0000e+00
44/81 [===============>..............] - ETA: 0s - loss: 0.3883 - accuracy: 0.0000e+00
53/81 [==================>...........] - ETA: 0s - loss: 0.3734 - accuracy: 0.0000e+00
62/81 [=====================>........] - ETA: 0s - loss: 0.3700 - accuracy: 0.0000e+00
71/81 [=========================>....] - ETA: 0s - loss: 0.3725 - accuracy: 0.0000e+00
80/81 [============================>.] - ETA: 0s - loss: 0.3730 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.3734 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.3734 - accuracy: 0.0000e+00
Epoch 6/20

 1/81 [..............................] - ETA: 0s - loss: 1.1583 - accuracy: 0.0000e+00
10/81 [==>...........................] - ETA: 0s - loss: 0.5097 - accuracy: 0.0000e+00
19/81 [======>.......................] - ETA: 0s - loss: 0.4409 - accuracy: 0.0000e+00
28/81 [=========>....................] - ETA: 0s - loss: 0.4065 - accuracy: 0.0000e+00
36/81 [============>.................] - ETA: 0s - loss: 0.3826 - accuracy: 0.0000e+00
45/81 [===============>..............] - ETA: 0s - loss: 0.3653 - accuracy: 0.0000e+00
54/81 [===================>..........] - ETA: 0s - loss: 0.3586 - accuracy: 0.0000e+00
63/81 [======================>.......] - ETA: 0s - loss: 0.3573 - accuracy: 0.0000e+00
72/81 [=========================>....] - ETA: 0s - loss: 0.3637 - accuracy: 0.0000e+00
80/81 [============================>.] - ETA: 0s - loss: 0.3686 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.3684 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.3684 - accuracy: 0.0000e+00
Epoch 7/20

 1/81 [..............................] - ETA: 0s - loss: 1.1450 - accuracy: 0.0000e+00
 9/81 [==>...........................] - ETA: 0s - loss: 0.5335 - accuracy: 0.0000e+00
17/81 [=====>........................] - ETA: 0s - loss: 0.4628 - accuracy: 0.0000e+00
26/81 [========>.....................] - ETA: 0s - loss: 0.4280 - accuracy: 0.0000e+00
34/81 [===========>..................] - ETA: 0s - loss: 0.3954 - accuracy: 0.0000e+00
42/81 [==============>...............] - ETA: 0s - loss: 0.3783 - accuracy: 0.0000e+00
51/81 [=================>............] - ETA: 0s - loss: 0.3597 - accuracy: 0.0000e+00
60/81 [=====================>........] - ETA: 0s - loss: 0.3569 - accuracy: 0.0000e+00
69/81 [========================>.....] - ETA: 0s - loss: 0.3515 - accuracy: 0.0000e+00
77/81 [===========================>..] - ETA: 0s - loss: 0.3500 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.3508 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.3508 - accuracy: 0.0000e+00
Epoch 8/20

 1/81 [..............................] - ETA: 0s - loss: 1.0118 - accuracy: 0.0000e+00
 9/81 [==>...........................] - ETA: 0s - loss: 0.4696 - accuracy: 0.0000e+00
17/81 [=====>........................] - ETA: 0s - loss: 0.4049 - accuracy: 0.0000e+00
26/81 [========>.....................] - ETA: 0s - loss: 0.3854 - accuracy: 0.0000e+00
35/81 [===========>..................] - ETA: 0s - loss: 0.3585 - accuracy: 0.0000e+00
44/81 [===============>..............] - ETA: 0s - loss: 0.3440 - accuracy: 0.0000e+00
52/81 [==================>...........] - ETA: 0s - loss: 0.3378 - accuracy: 0.0000e+00
61/81 [=====================>........] - ETA: 0s - loss: 0.3390 - accuracy: 0.0000e+00
69/81 [========================>.....] - ETA: 0s - loss: 0.3371 - accuracy: 0.0000e+00
75/81 [==========================>...] - ETA: 0s - loss: 0.3338 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 7ms/step - loss: 0.3352 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.3352 - accuracy: 0.0000e+00
Epoch 9/20

 1/81 [..............................] - ETA: 0s - loss: 0.8777 - accuracy: 0.0000e+00
 9/81 [==>...........................] - ETA: 0s - loss: 0.4511 - accuracy: 0.0000e+00
18/81 [=====>........................] - ETA: 0s - loss: 0.4025 - accuracy: 0.0000e+00
27/81 [=========>....................] - ETA: 0s - loss: 0.3700 - accuracy: 0.0000e+00
36/81 [============>.................] - ETA: 0s - loss: 0.3482 - accuracy: 0.0000e+00
45/81 [===============>..............] - ETA: 0s - loss: 0.3335 - accuracy: 0.0000e+00
53/81 [==================>...........] - ETA: 0s - loss: 0.3257 - accuracy: 0.0000e+00
61/81 [=====================>........] - ETA: 0s - loss: 0.3264 - accuracy: 0.0000e+00
69/81 [========================>.....] - ETA: 0s - loss: 0.3210 - accuracy: 0.0000e+00
78/81 [===========================>..] - ETA: 0s - loss: 0.3194 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.3214 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.3214 - accuracy: 0.0000e+00
Epoch 10/20

 1/81 [..............................] - ETA: 0s - loss: 0.8479 - accuracy: 0.0000e+00
 9/81 [==>...........................] - ETA: 0s - loss: 0.4344 - accuracy: 0.0000e+00
18/81 [=====>........................] - ETA: 0s - loss: 0.3816 - accuracy: 0.0000e+00
27/81 [=========>....................] - ETA: 0s - loss: 0.3470 - accuracy: 0.0000e+00
36/81 [============>.................] - ETA: 0s - loss: 0.3260 - accuracy: 0.0000e+00
45/81 [===============>..............] - ETA: 0s - loss: 0.3100 - accuracy: 0.0000e+00
53/81 [==================>...........] - ETA: 0s - loss: 0.3050 - accuracy: 0.0000e+00
62/81 [=====================>........] - ETA: 0s - loss: 0.3033 - accuracy: 0.0000e+00
71/81 [=========================>....] - ETA: 0s - loss: 0.3024 - accuracy: 0.0000e+00
79/81 [============================>.] - ETA: 0s - loss: 0.3030 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.3026 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.3026 - accuracy: 0.0000e+00
Epoch 11/20

 1/81 [..............................] - ETA: 0s - loss: 0.6136 - accuracy: 0.0000e+00
 9/81 [==>...........................] - ETA: 0s - loss: 0.3721 - accuracy: 0.0000e+00
17/81 [=====>........................] - ETA: 0s - loss: 0.3475 - accuracy: 0.0000e+00
25/81 [========>.....................] - ETA: 0s - loss: 0.3264 - accuracy: 0.0000e+00
34/81 [===========>..................] - ETA: 0s - loss: 0.2992 - accuracy: 0.0000e+00
43/81 [==============>...............] - ETA: 0s - loss: 0.2771 - accuracy: 0.0000e+00
52/81 [==================>...........] - ETA: 0s - loss: 0.2647 - accuracy: 0.0000e+00
60/81 [=====================>........] - ETA: 0s - loss: 0.2611 - accuracy: 0.0000e+00
69/81 [========================>.....] - ETA: 0s - loss: 0.2602 - accuracy: 0.0000e+00
77/81 [===========================>..] - ETA: 0s - loss: 0.2607 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.2623 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.2623 - accuracy: 0.0000e+00
Epoch 12/20

 1/81 [..............................] - ETA: 0s - loss: 0.9494 - accuracy: 0.0000e+00
10/81 [==>...........................] - ETA: 0s - loss: 0.4115 - accuracy: 0.0000e+00
18/81 [=====>........................] - ETA: 0s - loss: 0.3282 - accuracy: 0.0000e+00
27/81 [=========>....................] - ETA: 0s - loss: 0.2920 - accuracy: 0.0000e+00
36/81 [============>.................] - ETA: 0s - loss: 0.2721 - accuracy: 0.0000e+00
44/81 [===============>..............] - ETA: 0s - loss: 0.2522 - accuracy: 0.0000e+00
52/81 [==================>...........] - ETA: 0s - loss: 0.2432 - accuracy: 0.0000e+00
61/81 [=====================>........] - ETA: 0s - loss: 0.2368 - accuracy: 0.0000e+00
69/81 [========================>.....] - ETA: 0s - loss: 0.2347 - accuracy: 0.0000e+00
77/81 [===========================>..] - ETA: 0s - loss: 0.2336 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.2352 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.2352 - accuracy: 0.0000e+00
Epoch 13/20

 1/81 [..............................] - ETA: 0s - loss: 0.5150 - accuracy: 0.0000e+00
 9/81 [==>...........................] - ETA: 0s - loss: 0.2720 - accuracy: 0.0000e+00
18/81 [=====>........................] - ETA: 0s - loss: 0.2419 - accuracy: 0.0000e+00
26/81 [========>.....................] - ETA: 0s - loss: 0.2285 - accuracy: 0.0000e+00
34/81 [===========>..................] - ETA: 0s - loss: 0.2291 - accuracy: 0.0000e+00
41/81 [==============>...............] - ETA: 0s - loss: 0.2230 - accuracy: 0.0000e+00
49/81 [=================>............] - ETA: 0s - loss: 0.2123 - accuracy: 0.0000e+00
57/81 [====================>.........] - ETA: 0s - loss: 0.2123 - accuracy: 0.0000e+00
65/81 [=======================>......] - ETA: 0s - loss: 0.2121 - accuracy: 0.0000e+00
74/81 [==========================>...] - ETA: 0s - loss: 0.2190 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.2206 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.2206 - accuracy: 0.0000e+00
Epoch 14/20

 1/81 [..............................] - ETA: 0s - loss: 0.3170 - accuracy: 0.0000e+00
 9/81 [==>...........................] - ETA: 0s - loss: 0.2753 - accuracy: 0.0000e+00
16/81 [====>.........................] - ETA: 0s - loss: 0.2593 - accuracy: 0.0000e+00
24/81 [=======>......................] - ETA: 0s - loss: 0.2422 - accuracy: 0.0000e+00
32/81 [==========>...................] - ETA: 0s - loss: 0.2272 - accuracy: 0.0000e+00
40/81 [=============>................] - ETA: 0s - loss: 0.2234 - accuracy: 0.0000e+00
48/81 [================>.............] - ETA: 0s - loss: 0.2134 - accuracy: 0.0000e+00
55/81 [===================>..........] - ETA: 0s - loss: 0.2123 - accuracy: 0.0000e+00
63/81 [======================>.......] - ETA: 0s - loss: 0.2163 - accuracy: 0.0000e+00
70/81 [========================>.....] - ETA: 0s - loss: 0.2173 - accuracy: 0.0000e+00
79/81 [============================>.] - ETA: 0s - loss: 0.2241 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 7ms/step - loss: 0.2247 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.2247 - accuracy: 0.0000e+00
Epoch 15/20

 1/81 [..............................] - ETA: 0s - loss: 0.3073 - accuracy: 0.0000e+00
 9/81 [==>...........................] - ETA: 0s - loss: 0.3156 - accuracy: 0.0000e+00
18/81 [=====>........................] - ETA: 0s - loss: 0.2693 - accuracy: 0.0000e+00
26/81 [========>.....................] - ETA: 0s - loss: 0.2407 - accuracy: 0.0000e+00
35/81 [===========>..................] - ETA: 0s - loss: 0.2330 - accuracy: 0.0000e+00
43/81 [==============>...............] - ETA: 0s - loss: 0.2203 - accuracy: 0.0000e+00
51/81 [=================>............] - ETA: 0s - loss: 0.2123 - accuracy: 0.0000e+00
60/81 [=====================>........] - ETA: 0s - loss: 0.2121 - accuracy: 0.0000e+00
68/81 [========================>.....] - ETA: 0s - loss: 0.2141 - accuracy: 0.0000e+00
76/81 [===========================>..] - ETA: 0s - loss: 0.2176 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.2180 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.2180 - accuracy: 0.0000e+00
Epoch 16/20

 1/81 [..............................] - ETA: 1s - loss: 0.5290 - accuracy: 0.0000e+00
10/81 [==>...........................] - ETA: 0s - loss: 0.3024 - accuracy: 0.0000e+00
19/81 [======>.......................] - ETA: 0s - loss: 0.2603 - accuracy: 0.0000e+00
28/81 [=========>....................] - ETA: 0s - loss: 0.2308 - accuracy: 0.0000e+00
36/81 [============>.................] - ETA: 0s - loss: 0.2352 - accuracy: 0.0000e+00
44/81 [===============>..............] - ETA: 0s - loss: 0.2226 - accuracy: 0.0000e+00
52/81 [==================>...........] - ETA: 0s - loss: 0.2132 - accuracy: 0.0000e+00
61/81 [=====================>........] - ETA: 0s - loss: 0.2121 - accuracy: 0.0000e+00
69/81 [========================>.....] - ETA: 0s - loss: 0.2138 - accuracy: 0.0000e+00
78/81 [===========================>..] - ETA: 0s - loss: 0.2214 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 6ms/step - loss: 0.2230 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.2230 - accuracy: 0.0000e+00
Epoch 17/20

 1/81 [..............................] - ETA: 0s - loss: 0.3725 - accuracy: 0.0000e+00
 8/81 [=>............................] - ETA: 0s - loss: 0.2726 - accuracy: 0.0000e+00
16/81 [====>.........................] - ETA: 0s - loss: 0.2329 - accuracy: 0.0000e+00
24/81 [=======>......................] - ETA: 0s - loss: 0.2127 - accuracy: 0.0000e+00
31/81 [==========>...................] - ETA: 0s - loss: 0.2019 - accuracy: 0.0000e+00
38/81 [=============>................] - ETA: 0s - loss: 0.2003 - accuracy: 0.0000e+00
45/81 [===============>..............] - ETA: 0s - loss: 0.1922 - accuracy: 0.0000e+00
52/81 [==================>...........] - ETA: 0s - loss: 0.1865 - accuracy: 0.0000e+00
59/81 [====================>.........] - ETA: 0s - loss: 0.1902 - accuracy: 0.0000e+00
66/81 [=======================>......] - ETA: 0s - loss: 0.1905 - accuracy: 0.0000e+00
73/81 [==========================>...] - ETA: 0s - loss: 0.1989 - accuracy: 0.0000e+00
80/81 [============================>.] - ETA: 0s - loss: 0.2016 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 7ms/step - loss: 0.2026 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 9ms/step - loss: 0.2026 - accuracy: 0.0000e+00
Epoch 18/20

 1/81 [..............................] - ETA: 0s - loss: 0.3014 - accuracy: 0.0000e+00
 8/81 [=>............................] - ETA: 0s - loss: 0.2769 - accuracy: 0.0000e+00
17/81 [=====>........................] - ETA: 0s - loss: 0.2315 - accuracy: 0.0000e+00
24/81 [=======>......................] - ETA: 0s - loss: 0.2207 - accuracy: 0.0000e+00
32/81 [==========>...................] - ETA: 0s - loss: 0.2170 - accuracy: 0.0000e+00
40/81 [=============>................] - ETA: 0s - loss: 0.2085 - accuracy: 0.0000e+00
48/81 [================>.............] - ETA: 0s - loss: 0.2013 - accuracy: 0.0000e+00
55/81 [===================>..........] - ETA: 0s - loss: 0.1997 - accuracy: 0.0000e+00
62/81 [=====================>........] - ETA: 0s - loss: 0.1998 - accuracy: 0.0000e+00
70/81 [========================>.....] - ETA: 0s - loss: 0.2015 - accuracy: 0.0000e+00
77/81 [===========================>..] - ETA: 0s - loss: 0.2065 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 7ms/step - loss: 0.2083 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 9ms/step - loss: 0.2083 - accuracy: 0.0000e+00
Epoch 19/20

 1/81 [..............................] - ETA: 0s - loss: 0.2798 - accuracy: 0.0000e+00
 8/81 [=>............................] - ETA: 0s - loss: 0.2926 - accuracy: 0.0000e+00
14/81 [====>.........................] - ETA: 0s - loss: 0.2609 - accuracy: 0.0000e+00
22/81 [=======>......................] - ETA: 0s - loss: 0.2353 - accuracy: 0.0000e+00
30/81 [==========>...................] - ETA: 0s - loss: 0.2197 - accuracy: 0.0000e+00
38/81 [=============>................] - ETA: 0s - loss: 0.2185 - accuracy: 0.0000e+00
45/81 [===============>..............] - ETA: 0s - loss: 0.2097 - accuracy: 0.0000e+00
52/81 [==================>...........] - ETA: 0s - loss: 0.2061 - accuracy: 0.0000e+00
59/81 [====================>.........] - ETA: 0s - loss: 0.2102 - accuracy: 0.0000e+00
67/81 [=======================>......] - ETA: 0s - loss: 0.2121 - accuracy: 0.0000e+00
72/81 [=========================>....] - ETA: 0s - loss: 0.2141 - accuracy: 0.0000e+00
80/81 [============================>.] - ETA: 0s - loss: 0.2127 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 7ms/step - loss: 0.2125 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 9ms/step - loss: 0.2125 - accuracy: 0.0000e+00
Epoch 20/20

 1/81 [..............................] - ETA: 0s - loss: 0.2366 - accuracy: 0.0000e+00
 9/81 [==>...........................] - ETA: 0s - loss: 0.2507 - accuracy: 0.0000e+00
18/81 [=====>........................] - ETA: 0s - loss: 0.2222 - accuracy: 0.0000e+00
26/81 [========>.....................] - ETA: 0s - loss: 0.2045 - accuracy: 0.0000e+00
34/81 [===========>..................] - ETA: 0s - loss: 0.2039 - accuracy: 0.0000e+00
42/81 [==============>...............] - ETA: 0s - loss: 0.1971 - accuracy: 0.0000e+00
50/81 [=================>............] - ETA: 0s - loss: 0.1906 - accuracy: 0.0000e+00
58/81 [====================>.........] - ETA: 0s - loss: 0.1928 - accuracy: 0.0000e+00
66/81 [=======================>......] - ETA: 0s - loss: 0.1959 - accuracy: 0.0000e+00
73/81 [==========================>...] - ETA: 0s - loss: 0.1983 - accuracy: 0.0000e+00
80/81 [============================>.] - ETA: 0s - loss: 0.2029 - accuracy: 0.0000e+00
81/81 [==============================] - 1s 7ms/step - loss: 0.2037 - accuracy: 0.0000e+00

81/81 [==============================] - 1s 8ms/step - loss: 0.2037 - accuracy: 0.0000e+00

lstm_forecast <- lstm_model %>%
    predict(x_pred_arr, batch_size = 1) %>%
    .[, , 1]

1/1 [==============================] - 1s 1s/step

1/1 [==============================] - 1s 1s/step

 
# rescale en format basique
lstm_forecast <- lstm_forecast * scale_factors[2] + scale_factors[1]
lstm_forecast

 [1] 459865.7 464270.5 431565.1 442693.1 455369.7 453950.0
 [7] 473753.8 467633.8 459334.6 482096.4 454499.0 381109.3

X résultats / prédictions par input donc > transforme pour une seule prédiciton

fitted <- predict(lstm_model, x_train_arr, batch_size = 1) %>%
     .[, , 1]

 1/81 [..............................] - ETA: 1s
23/81 [=======>......................] - ETA: 0s
43/81 [==============>...............] - ETA: 0s
65/81 [=======================>......] - ETA: 0s
81/81 [==============================] - 0s 2ms/step

81/81 [==============================] - 0s 2ms/step

if (dim(fitted)[2] > 1) {
    fit <- c(fitted[, 1], fitted[dim(fitted)[1], 2:dim(fitted)[2]])
} else {
    fit <- fitted[, 1]
}

# rescale final de nos données
fitted <- fit * scale_factors[2] + scale_factors[1]
fitted

 [1] 262918.6 264691.5 290889.0 303122.2 314529.3 328454.2
 [7] 288171.8 261282.6 306581.7 288037.8 265662.6 280645.2
[13] 280822.6 272328.9 314008.2 310983.3 326743.0 346064.5
[19] 300931.5 266732.3 320298.7 307821.0 291250.4 302792.3
[25] 324627.1 323489.9 350129.7 344771.4 357006.4 384302.5
[31] 331226.1 291711.0 348780.1 354906.1 322972.3 312396.6
[37] 358186.5 354725.7 399205.4 385704.2 391630.5 408883.1
[43] 361685.7 325749.1 378625.9 378832.8 347489.1 375327.1
[49] 376304.6 377306.2 412887.1 395036.4 383213.9 430576.6
[55] 385044.7 342721.4 408489.9 410726.2 372916.9 392945.1
[61] 393156.0 400025.5 436991.4 431726.2 418205.2 429711.9
[67] 405719.8 356297.2 426671.5 438300.6 392091.9 421278.0
[73] 424864.1 420718.3 455801.7 446976.4 445379.2 464230.2
[79] 425602.3 369791.7 446707.1 449840.2 418900.3 426666.9
[85] 437129.2 443043.2 471919.4 458081.5 466414.5 463707.9
[91] 451208.1 382540.9

fitted <- c(rep(NA, lag), fitted)
fitted

  [1]       NA       NA       NA       NA       NA       NA
  [7]       NA       NA       NA       NA       NA       NA
 [13] 262918.6 264691.5 290889.0 303122.2 314529.3 328454.2
 [19] 288171.8 261282.6 306581.7 288037.8 265662.6 280645.2
 [25] 280822.6 272328.9 314008.2 310983.3 326743.0 346064.5
 [31] 300931.5 266732.3 320298.7 307821.0 291250.4 302792.3
 [37] 324627.1 323489.9 350129.7 344771.4 357006.4 384302.5
 [43] 331226.1 291711.0 348780.1 354906.1 322972.3 312396.6
 [49] 358186.5 354725.7 399205.4 385704.2 391630.5 408883.1
 [55] 361685.7 325749.1 378625.9 378832.8 347489.1 375327.1
 [61] 376304.6 377306.2 412887.1 395036.4 383213.9 430576.6
 [67] 385044.7 342721.4 408489.9 410726.2 372916.9 392945.1
 [73] 393156.0 400025.5 436991.4 431726.2 418205.2 429711.9
 [79] 405719.8 356297.2 426671.5 438300.6 392091.9 421278.0
 [85] 424864.1 420718.3 455801.7 446976.4 445379.2 464230.2
 [91] 425602.3 369791.7 446707.1 449840.2 418900.3 426666.9
 [97] 437129.2 443043.2 471919.4 458081.5 466414.5 463707.9
[103] 451208.1 382540.9

length(fitted)

[1] 104

lstm_forecast <- ts(lstm_forecast,
    start = c(2019, 1),
    end = c(2019, 12),
    frequency = 12
)

lstm_forecast_display <- window(lstm_forecast, start= c(2019,1), end = c(2019,8))

input_ts <- ts(data$y, 
    start = c(2011, 1), 
    end = c(2018, 12), 
    frequency = 12)


lstm_forecast_display

          Jan      Feb      Mar      Apr      May      Jun
2019 459865.7 464270.5 431565.1 442693.1 455369.7 453950.0
          Jul      Aug
2019 473753.8 467633.8

data_ts_test

        Jan    Feb    Mar    Apr    May    Jun    Jul    Aug
2019 443700 441499 480649 463680 453372 505190 445332 370211

plot(input_ts, xlim=c(2011,2020))
#lines(data_ts_test)
lines(lstm_forecast_display, col=3)

NA
NA
NA